home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0693 / SCBITMAP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-30  |  1KB  |  53 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 332 of 374
  3. From : Sean Palmer                         1:104/123.0          26 May 93  00:24
  4. To   : All
  5. Subj : Scaling Bitmaps
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Don't know if anyone is interested, but here is some code to scale
  8. bitmaps. I JUST now wrote it, and it's tested, but it hasn't even begun
  9. to be optimized yet (that's why it's still postable in the Pascal Echo,
  10. no .ASM stuff yet)  8)
  11.  
  12. works with VGA mode $13.}
  13.  
  14. type
  15.  fixed=record case boolean of
  16.         true:(l:longint);
  17.         false:(f:word;i:integer);
  18.         end;
  19.  
  20. procedure scaleBitmap(var bitmap;x,y:word;x1,y1,x2,y2:word);
  21. var
  22.  a,i:word;
  23.  sx,sy,cy,s:fixed;
  24.  map:array[0..65521]of byte absolute bitmap;
  25. begin
  26.  sx.l:=(x*$10000)div succ(x2-x1); sy.l:=(y*$10000)div succ(y2-y1);
  27.  cy.i:=pred(y); cy.f:=$FFFF;
  28.  while cy.i>=0 do begin
  29.   a:=y2*320+x1;
  30.   s.l:=(cy.i*x)*$10000;
  31.   for i:=x2-x1 downto 0 do begin
  32.    mem[$A000:a]:=map[s.i];
  33.    inc(a);
  34.    inc(s.l,sx.l);
  35.    end;
  36.   dec(cy.l,sy.l); dec(y2);
  37.   end;
  38.  end;
  39.  
  40. const
  41.  bmp:array[0..3,0..3]of byte=
  42.   ((0,1,2,3),
  43.    (1,2,3,4),
  44.    (2,3,4,5),
  45.    (3,4,5,6));
  46. var i:integer;
  47.  
  48. begin
  49.  asm mov ax,$13; int $10; end;
  50.  for i:=1 to 99 do
  51.   scaleBitMap(bmp,4,4,0,0,i*2,i*2);
  52.  asm mov ax,$3; int $10; end;
  53.  end.